home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / hk / bassrc / hk4main.bas < prev    next >
BASIC Source File  |  1993-07-08  |  19KB  |  500 lines
  1. 10 '------------------------------------------------------------------
  2. 20 '  HK4MAIN.BAS  Copyrigit(C) T.Komura   / 家計簿システム      /
  3. 30 '                                       / Version 4           /
  4. 31 '  Version 4.0  1992.08.08              / MAINプログラム      /
  5. 32 '                                       /                     /
  6. 100 '------------------------------------------------------------------
  7. 150 DIM CFI$(15)
  8. 160 GOSUB *CONFIGファイルチェック
  9. 170 'LOCATE 0,5
  10. 175 'PRINT PRGDRV$,DATDRV$,RAMDRV$,TIFDRV$,FMBDRV$,SNDMF,SNDDRV$,SWAIT
  11. 180 'FOR II=1 TO 15:PRINT CFI$(II):NEXT II:STOP
  12. 190 '
  13. 193 VERN$="4.0" 'バージョンNo.
  14. 200 *初期設定:'--------------------------------------------------------
  15. 210 CMD$="CD "+PRGDRV$:SHELL CMD$
  16. 220 SCREEN@ 0 :COLOR 7,0,0,4:CLS:CONSOLE 0,24,0:MOUSE 0
  17. 230 DIM MSGD%(28000):' 音声メッセージ配列定義 プログラム先頭で定義
  18. 235 DIM  L_W$(80)
  19. 240 LOAD@ FMBDRV$+"\FMP.FMB"
  20. 250 PLAY "@30T150V6":DATX$=DATE$
  21. 260 DIM XB1(2,5),XB2(2,5),YB1(2,5),YB2(2,5),BST(2,5)
  22. 265 DIM DYN$(20),DRM$(20)
  23. 270 DIM CUTN#(795)
  24. 320 GOSUB *ボタン座標読み取り
  25. 330 'CLS:COLOR 7:PRINT int((int(((630-234+1)+7)/8)*(97-71+1)*4+8-1)/8)
  26. 370 ON ERROR GOTO *ERROR
  27. 380 '
  28. 1000 *メインルーチン:'･･･････････････････････････････････････････････････
  29. 1005 GOSUB *表紙表示
  30. 1010 MESN=21:GOSUB *SNDMSG
  31. 1020 MOUSE 1,320,64,1
  32. 1040 GOSUB *HLIDXファイルチェック
  33. 1100 *メイン選択
  34. 1110 '
  35. 1130 SWPASS=1:G=1:GOSUB *マウスボタン選択
  36. 1145 IF SWNO>4 THEN *メイン選択
  37. 1150 ON SWNO GOTO *S01,*S02,*S03,*S04
  38. 1160 GOTO 1100:STOP
  39. 2000 *S01
  40. 2020  G=1:B=1:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  41. 2030  CHAIN "HK4IN.BAS"
  42. 2100 *S02
  43. 2120  G=1:B=2:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  44. 2130  CHAIN "HK4SRCH.BAS"
  45. 2200 *S03
  46. 2220  G=1:B=3:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  47. 2230  CHAIN "HK4ANLY.BAS"
  48. 3490 '
  49. 8940 '
  50. 9000 *S04:'終了････････････････････････････････････････････････････････
  51. 9020 G=1:B=4:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  52. 9110 MESN=6:GOSUB *SNDMSG
  53. 9120 FOR II=1 TO 5000:NEXT II
  54. 9130 MOUSE 5:GOSUB *FADEOUT
  55. 9140 SHELL "cd \"
  56. 9150 SYSTEM
  57. 9160 '
  58. 9900 '-------------------------------------------------------------------
  59. 9910 '    ＧＥＮＥＲＡＬ　ＳＵＢ　ＲＯＵＴＩＮＥ
  60. 9920 '-------------------------------------------------------------------
  61. 10000 *CHR1IN:'////////// 1文字入力
  62. 10010  A$=INKEY$:IF A$="" THEN 10010
  63. 10020  A=INSTR(C$,A$)
  64. 10030  IF A=0 THEN MESN=13:GOSUB *SNDMSG:GOTO 10010
  65. 10040  RETURN
  66. 10050 '
  67. 10060 '
  68. 10990 '
  69. 11000 *SNDMSG:'  SAVE "SNDMSG.SUB",A
  70. 11005  IF SNDMF=0 THEN RETURN
  71. 11010  '･････････････････  サウンドメッセージ実行サブルーチン  1989.02.04
  72. 11020  '                   入力=MESN (メッセージNo.)
  73. 11030  '
  74. 11070  IF MESN>36 THEN *RETURN_SNDMSG :'END
  75. 11080  RESTORE *MSGNAM
  76. 11090  FOR IMSG=1 TO MESN
  77. 11100    READ MSGD$
  78. 11110  NEXT IMSG
  79. 11120  MSGFN$=SNDDRV$+"\"+MSGD$+"_F.SND"
  80. 11130  LOAD@ MSGFN$,MSGD%
  81. 11140  PCMPLAY MSGD%:WAIT SWAIT
  82. 11150 *RETURN_SNDMSG :RETURN
  83. 11160 *MSGNAM :'////////// .SND File Name Data
  84. 11170 DATA "OHA1"   :'  1 おはよう
  85. 11180 DATA "KONN"   :'  2 こんにちわ
  86. 11190 DATA "KONBAN" :'  3 こんばんわ
  87. 11200 DATA "GOKRO1" :'  4 ごくろうさん
  88. 11210 DATA "GOKRO2" :'  5 ごくろうさま
  89. 11220 DATA "OTUKA"  :'  6 お疲れさま
  90. 11230 DATA "OMATA"  :'  7 おまたせ
  91. 11240 DATA "ARIGA2" :'  8 ありがとう
  92. 11250 DATA "RUNRUN" :'  9 るんるん
  93. 11260 DATA "DAMEDE" :' 10 だめでしょう
  94. 11270 DATA "IIDE1"  :' 11 いいですか
  95. 11280 DATA "NANISI" :' 12 なにしてるの
  96. 11290 DATA "DAMEDA" :' 13 だめだめ
  97. 11300 DATA "OWARI"  :' 14 終わりました
  98. 11310 DATA "SIBA"   :' 15 しばらくお待ち下さい
  99. 11320 DATA "YOROSI" :' 16 よろしいですか
  100. 11330 DATA "TYANTO" :' 17 ちゃんとしなさい
  101. 11340 DATA "ERANDE" :' 18 選んでください
  102. 11350 DATA "KAKNIN" :' 19 確認して下さい
  103. 11360 DATA "NYURYO" :' 20 入力してください
  104. 11370 DATA "IRA"    :' 21 いらっしゃいませ 
  105. 11380 DATA "OYASUM" :' 22 おやすみ
  106. 11390 DATA "ARIGA3" :' 23 ありがとうございました
  107. 11400 DATA "TYOTO"  :' 24 ちょっと待って
  108. 11410 DATA "OOKINA" :' 25 大きな間違い
  109. 11420 DATA "YAMETE" :' 26 やめて
  110. 11430 DATA "TIGAU"  :' 27 ちがうよ
  111. 11440 DATA "PINPON" :' 28 ぴんぽーん
  112. 11450 DATA "BUU"    :' 29 ぶー
  113. 11460 DATA "MOUII"  :' 30 もういいよう  
  114. 11470 DATA "DEKITA" :' 31 できたよー
  115. 11480 DATA "IIDE2"  :' 32 いいですか（２）
  116. 11490 DATA "YOSI"   :' 33 よしなさい
  117. 11500 DATA "OYOSI"  :' 34 およしなさい
  118. 11510 DATA "YAMENA" :' 35 やめなさい
  119. 11520 DATA "GOMEN"  :' 36 ごめん
  120. 11530 '                                    
  121. 13000 '                                          1993.02.12 T.Komura
  122. 13010 *LKEYIN  :'･･･････････ 1 行全角文字入力サブルーチン
  123. 13020 ' v1.1a   入力 = LX,LY : 表示開始座標  出力 = LMG$ : 入力後の文字列
  124. 13030 '                LM$   : 初期文字列
  125. 13040 '                LC    : 表示文字色
  126. 13050 '                LL    : 最大文字数
  127. 13060 '
  128. 13070 LCSRCL=2:LLINCL=6
  129. 13080 '      CR   MR   ML  INS  DEL   BS  CAN
  130. 13085 LMSX=MOUSE(0):LMSY=MOUSE(1):MOUSE 5     :'v1.1a
  131. 13090 CC$=CHR$(&H0D,&H1C,&H1D,&H12,&H7F,&H08,&H18)
  132. 13100 LMG$=SPACE$(LL):LMGD$=SPACE$(LL)
  133. 13110 LA$=INKEY$:IF LA$<>"" THEN 13110
  134. 13120 LCSR=0:LCSRX=LCSR:GOSUB *LCSRDX
  135. 13130 LOCATE LX,LY:COLOR LC:PRINT LM$ '        ･･････････ 初期文字列記憶
  136. 13140 LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  137. 13150 LMX$=LEFT$(LM$+SPACE$(LL),LL)
  138. 13160 GOSUB *LMREAD
  139. 13170 *IN1C:'                                  ･･････････ 1 文字入力
  140. 13180 LA$=INKEY$:IF LA$="" THEN 13180
  141. 13190 ALA=ASC(LA$):CLA=INSTR(CC$,LA$)
  142. 13200 IF CLA=0 THEN 13220
  143. 13210 ON CLA GOTO *CR,*MR,*ML,*INS,*DEL,*BS,*CAN
  144. 13220 IF KANF=1 THEN *KANJI
  145. 13230 IF ALA<&H20 THEN BEEP:GOTO *IN1C
  146. 13240 IF ALA>=&H20 AND ALA<&H80 THEN *ANK
  147. 13250 IF ALA>=&HA0 AND ALA<&HE0 THEN *ANK
  148. 13260 GOTO *KANJI
  149. 13270 *ANK :'                                  ･･････････ ANK 文字入力
  150. 13280 LOCATE LX+LCSR,LY:COLOR LC:PRINT LA$
  151. 13290 MID$(LMX$,LCSR+1,1)=LA$
  152. 13300 GOSUB *LCSRINC:GOTO *IN1C
  153. 13310 *KANJI :'                                ･･････････ 漢字文字入力
  154. 13320 ON KANF+1 GOTO 13330,13360
  155. 13330 KANF=1:KANW$="":KANW$=LA$
  156. 13340 IF LCSR+1>=LL THEN KANF=0:BEEP
  157. 13350 GOSUB *LCSRD:GOTO *IN1C
  158. 13360 KANF=0:KANW$=KANW$+LA$
  159. 13370 LOCATE LX+LCSR,LY:COLOR LC:PRINT KANW$
  160. 13380 MID$(LMX$,LCSR+1,2)=KANW$
  161. 13390 GOSUB *LCSR2INC:GOTO *IN1C
  162. 13400 *CR :GOSUB *LMREAD :GOSUB *LCSRDX         '////////// End
  163. 13410 LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  164. 13415 MOUSE 0: MOUSE 1,LMSX,LMSY,1              :'v1.1a
  165. 13420 RETURN:'----------------------------------------------------------
  166. 13430 *MR :GOSUB *LCSRINC                       '////////// Right
  167. 13440 GOTO *IN1C
  168. 13450 *ML :GOSUB *LCSRDEC                       '////////// Left
  169. 13460 GOTO *IN1C
  170. 13470 *INS:GOSUB *LMREAD                       '////////// Insert
  171. 13480 IF LMGF$="2" THEN BEEP:GOTO *IN1C
  172. 13490 LMX$=LEFT$(LMG$,LCSR)+" "+MID$(LMG$,LCSR+1,LL-1-LCSR)
  173. 13500 GOSUB *LMXDSP
  174. 13510 GOTO *IN1C
  175. 13520 *DEL:GOSUB *LMREAD                       '////////// Delete
  176. 13530 IF LMGF$="2" THEN BEEP:GOTO *IN1C
  177. 13540 IF LMGF$="1" THEN 13560
  178. 13550 LMX$=LEFT$(LMG$,LCSR)+MID$(LMG$,LCSR+2,LL-1-LCSR)+" ":GOTO 13570
  179. 13560 LMX$=LEFT$(LMG$,LCSR)+MID$(LMG$,LCSR+3,LL-2-LCSR)+"  "
  180. 13570 GOSUB *LMREAD
  181. 13580 GOSUB *LMXDSP:GOTO *IN1C
  182. 13590 *BS :GOSUB *LMREAD                       '////////// BackSpace
  183. 13600 IF LCSR=0 THEN BEEP:GOTO *IN1C
  184. 13610 IF LMGF$="2" THEN BEEP:GOTO *IN1C
  185. 13620 GOSUB *LCSRDEC:GOSUB *LMREAD:LMGFX$=LMGF$
  186. 13630 LMX$=LEFT$(LMG$,LCSR)+MID$(LMG$,LCSR+2,LL-1-LCSR)+" "
  187. 13640 IF LMGFX$="2" THEN LMGFX$="0":GOSUB *LMREAD:GOTO 13620
  188. 13650 GOSUB *LMXDSP
  189. 13660 GOTO *IN1C
  190. 13670 *CAN :LMX$=SPACE$(LL)                    '////////// Clear
  191. 13680 GOSUB *LMXDSP:LCSR=0:GOSUB *LCSRD
  192. 13690 GOSUB *LMREAD:GOTO *IN1C
  193. 13700 *LMREAD:                                 '////////// Disp Char Read 
  194. 13710 LMDX=0:LMGD$=""
  195. 13720 FOR II=1 TO LL
  196. 13730   LMG=ASC(MID$(LMX$,II,1))
  197. 13740   IF (LMG>=&H80) AND (LMG<&HA0) THEN LMDK=1 ELSE LMDK=0
  198. 13750   IF LMDX=1            THEN LMD$="2":LMDX=0:GOTO 13780
  199. 13760   IF LMDK=1 AND LMDX=0 THEN LMD$="1":LMDX=1:GOTO 13780
  200. 13770   IF LMDK=0 THEN            LMD$="0":LMDX=0
  201. 13780   LMGD$=LMGD$+LMD$
  202. 13790 NEXT II:LMGF$=MID$(LMGD$,LCSR+1,1):LMG$=LMX$
  203. 13800 RETURN
  204. 13810 *LCSRD :LXC=8*(LX+LCSR) :LYC=LY*19:GOSUB 13840: '//// Csr Disp
  205. 13820 *LCSRDX:LXC=8*(LX+LCSRX):LYC=LY*19:GOSUB 13840: '//// Csr Erace
  206. 13830 LCSRX=LCSR:RETURN
  207. 13840 LINE(LXC,LYC+0)-(LXC+1,LYC+14),XOR,LCSRCL,BF:RETURN
  208. 13850 *LCSRINC :LCSR=LCSR+1:IF LCSR>=LL THEN LCSR=LL-1
  209. 13860 GOSUB *LCSRD:RETURN
  210. 13870 *LCSR2INC:LCSR=LCSR+2:IF LCSR>=LL THEN LCSR=LL-2
  211. 13880 GOSUB *LCSRD:RETURN
  212. 13890 *LCSRDEC :LCSR=LCSR-1:IF LCSR<0   THEN LCSR=0
  213. 13900 GOSUB *LCSRD:RETURN
  214. 13910 *LMXDSP:LOCATE LX,LY:COLOR LC:PRINT LMX$;:RETURN
  215. 19000 '
  216. 19010 '//////////////////////////////////////////////////////////////
  217. 19020 *ERROR:'      エラー処理サブルーチン V1.10   1990.11.08 T.Komura
  218. 19030 '             
  219. 19040 '
  220. 19050 IF ERR=53 THEN *IOERR
  221. 19060 IF ERR=63 THEN *FILNOF
  222. 19070 IF ERR=67 THEN *DSKFUL
  223. 19080 IF ERR=71 THEN *DSKUNF 
  224. 19090 IF ERR=72 THEN *DSKOFF
  225. 19100 IF ERR=73 THEN *DSKWP
  226. 19110 ERMES$="エラー行:"+STR$(ERL)+" エラー番号:"+STR$(ERR)+" 発生"
  227. 19120 GOSUB *ERMSG
  228. 19130 STOP
  229. 19140 '////////// エラー処理
  230. 19150 *IOERR
  231. 19160 ERMES$="ﾌﾟﾘﾝﾀｰが準備されていません｡ ﾌﾟﾘﾝﾀｰをセット後､"
  232. 19170 GOSUB *ERMSG:RESUME
  233. 19180 *DSKFUL
  234. 19190 ERMES$="ディスクが満杯です｡ 交換後､"
  235. 19200 GOSUB *ERMSG:RESUME
  236. 19210 *DSKUNF
  237. 19220 ERMES$="このディスクは使用出来ません｡処理を中断します｡ "
  238. 19230 GOSUB *ERMSG:RESUME
  239. 19240 *DSKOFF
  240. 19250 ERMES$="ディスク装置が準備されていません｡ディスクをセット後､"
  241. 19260 GOSUB *ERMSG:RESUME
  242. 19270 *DSKWP
  243. 19280 ERMES$="ディスクが書き込み禁止になっています｡解除後､"
  244. 19290 GOSUB *ERMSG:RESUME
  245. 19300 *FILNOF
  246. 19310 ERMES$="ファイルが見つかりません｡ディスクを交換後､"
  247. 19320 GOSUB *ERMSG:RESUME
  248. 19330 '
  249. 19340 *ERMSG:'////////// エラーメッセージ
  250. 19350 LOCATE 2,23:COLOR 2,0
  251. 19355 PRINT SPACE$(77);
  252. 19359 LOCATE 2,23:COLOR 2,0
  253. 19360 PRINT ERMES$;"[実行]キーを押してね！";
  254. 19370 COLOR 7,0:MESN=19:GOSUB *SNDMSG
  255. 19380 ERRA$=INKEY$:IF ERRA$="" THEN 19380
  256. 19390 IF ERRA$<>CHR$(&H0D) THEN 19380
  257. 19400 LOCATE 3,23:COLOR 6,0
  258. 19410 PRINT "エラー処理を終わります｡";SPACE$(52);
  259. 19420 RETURN
  260. 19430 '
  261. 19440 '
  262. 19450 '
  263. 20000 '------------------------------------------------------------------
  264. 20010 ' ＣＵＳＴＯＭ　ＳＵＢ　ＲＯＵＴＩＮＥ FOR "DOQSO.BAS"
  265. 20020 '------------------------------------------------------------------
  266. 20100 *表紙表示
  267. 20105  PLAY "L16O7C<BAG>C<BAGR2>C<BAG>C<G>L4C"
  268. 20140  'RANDOMIZE TIME/3
  269. 20145  'A=INT(RND*6)+1:A$=RIGHT$(STR$(A),1)
  270. 20150  'LOAD@ TIFDRV$+"\MAINB"+A$+".tif",(0,0)
  271. 20155  LOAD@ TIFDRV$+"\MAINb.tif",(0,0)
  272. 20156  LOAD@ TIFDRV$+"\MAINt.tif",(156,83)'(296,3)
  273. 20180  RETURN
  274. 20190 '
  275. 20200 *HLIDXファイルチェック
  276. 20210  GOSUB *HKIOPN:CLOSE
  277. 20220  IF IR>0 THEN RETURN
  278. 20230  LOCATE 2,22:COLOR 6
  279. 20235  PRINT "ｲﾝﾃﾞｯｸｽﾌｧｲﾙがありません｡家計簿システム用のディスクを作成しますか?";
  280. 20240  CMES$="家計簿データディスク作成":GOSUB *確認
  281. 20245  LOCATE 2,22:PRINT SPACE$(76);
  282. 20250  ON SWNO GOTO 20260,*S04
  283. 20260  GOSUB *ファイル年月入力
  284. 20300  GOSUB *新規ファイル作成
  285. 20310  RETURN
  286. 20390 '
  287. 20400 *ファイル年月入力
  288. 20410  LOCATE 2,22:COLOR 7,0
  289. 20420  PRINT "何年何月の家計簿ファイルを作成しますか? ";
  290. 20430  SYMBOL(8*54,22*19),"    年   月",1,1,7,,,&H01
  291. 20440  GOSUB *本日の日付
  292. 20450  YR$=TY$:MN$=TM$
  293. 20470  LM$=YR$:LL=4:LC=5:LX=54:LY=22:GOSUB *LKEYIN
  294. 20475  YR$=LMG$
  295. 20480  LM$=MN$:LL=2:LC=5:LX=61:LY=22:GOSUB *LKEYIN
  296. 20485  MN$=LMG$
  297. 20510  LOCATE 2,22:COLOR 7,0
  298. 20520  PRINT YR$;"年";MN$;"月の家計簿ファイルを作成します｡";
  299. 20540  RETURN
  300. 20550 '
  301. 20700 *新規ファイル作成
  302. 20760  CMES$="["+YR$+"年"+MN$+"月]ファイル新規作成"
  303. 20770  GOSUB *確認
  304. 20780  ON SWNO GOTO 20800,*S04
  305. 20800  MESN=24:GOSUB *SNDMSG
  306. 20810  IYM$=YR$+MN$:IMAK$=SPACE$(32):'--------------IDX追加
  307. 20820  RI=IR+1:GOSUB *HKIPUT
  308. 20830  DEV$=SPACE$(64):DDM$=SPACE$(32):'------------ファイル作成
  309. 20835  FOR JJ=1 TO 16:DYN$(JJ)=SPACE$(10):DRM$(JJ)=SPACE$(32):NEXT JJ
  310. 20840  FOR RDY=1 TO 31
  311. 20845    LOCATE 70,22:COLOR 4:PRINT RIGHT$(STR$(RDY),2);" / 31";
  312. 20850    GOSUB *HKDPUT
  313. 20860  NEXT RDY:MESN=14:GOSUB *SNDMSG:LOCATE 70,23:PRINT SPACE$(8);
  314. 20870  RETURN
  315. 20880 '
  316. 20900 STOP
  317. 21000 *本日の日付
  318. 21010  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  319. 21020  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  320. 21030  TY$=RIGHT$(STR$(TY),4)
  321. 21040  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  322. 21050  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  323. 21100  RETURN
  324. 21110 '
  325. 22900 '------------------------------------------------------------------
  326. 30130 *ボタン座標読み取り
  327. 30140  RESTORE *ボタン座標:READ SWGN
  328. 30150  FOR G=1 TO SWGN
  329. 30160    READ SWN(G),SMX(G),SMY(G),SMW(G)
  330. 30170    FOR B=1 TO SWN(G)
  331. 30180      READ XB1(G,B),XB2(G,B),YB1(G,B),YB2(G,B)
  332. 30190    NEXT B
  333. 30200  NEXT G
  334. 30210  RETURN
  335. 30220 '
  336. 30230 *ボタンON_OFF表示
  337. 30240  IF BST(G,B)=1 THEN BSC=7:BSB=0:BSA=2:GOTO 30260
  338. 30250                    BSC=0:BSB=7:BSA=5
  339. 30260   CONNECT(XB1(G,B  ),YB2(G,B)  )-(XB2(G,B)  ,YB2(G,B)  )-(XB2(G,B  ),YB1(G,B)  ),BSC,PSET
  340. 30270   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB2(G,B)-1,YB2(G,B)-1)-(XB2(G,B)-1,YB1(G,B)+1),BSC,PSET
  341. 30280   CONNECT(XB1(G,B)  ,YB2(G,B)  )-(XB1(G,B)  ,YB1(G,B)  )-(XB2(G,B)  ,YB1(G,B)  ),BSB,PSET
  342. 30290   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB1(G,B)+1,YB1(G,B)+1)-(XB2(G,B)-1,YB1(G,B)+1),BSB,PSET
  343. 30300   LINE(XB1(G,B)+4,YB1(G,B)+4)-(XB1(G,B)+6,YB1(G,B)+5),PSET,BSA,BF
  344. 30305   IF BST(G,B)=1 THEN SMSGPLAY 0:WAIT 16
  345. 30310  RETURN
  346. 30320 '
  347. 30330 *マウスボタン選択
  348. 30340  SWERC=0
  349. 30350  IF MOUSE(2,0)=0 THEN 30350
  350. 30360  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):SWNO=0
  351. 30370  FOR IMS=1 TO SWN(G)
  352. 30380    IF (X_M>XB1(G,IMS) AND X_M<XB2(G,IMS)) ELSE 30410
  353. 30390    IF (Y_M>YB1(G,IMS) AND Y_M<YB2(G,IMS)) ELSE 30410
  354. 30400    SWNO=IMS:IMS=SWN(G)+1
  355. 30410  NEXT IMS:FOR IM=1 TO 500:NEXT IM
  356. 30430  IF SWNO=0 AND SWERC>5  THEN MESN=12:GOSUB *SNDMSG       :GOTO 30350
  357. 30440  IF SWNO=0              THEN SMSGPLAY 3:SWERC=SWERC+1:GOTO 30350
  358. 30460  SWPASS=0
  359. 30470  RETURN
  360. 30480 '
  361. 31000 *FADEOUT:CLS 1:CONSOLE 0,24,0
  362. 31010  FOR II=0 TO 15
  363. 31020    PALETTE II,[16*II,16*II,16*II]
  364. 31030  NEXT II
  365. 31040  FOR II=0 TO 255 STEP 5:WAIT SWAIT/50
  366. 31050    FOR JJ=0 TO 15:KK=16*JJ+II*(255-16*JJ)/255
  367. 31054      PALETTE JJ,[KK,KK,KK]
  368. 31056    NEXT JJ
  369. 31060  NEXT II
  370. 31070  RETURN
  371. 31080 '
  372. 31200 *確認
  373. 31205  LOCATE 27,3:PRINT SPACE$(52)
  374. 31210  GET@A(214,50)-(630,79),CUTN#
  375. 31220  LOAD@ TIFDRV$+"\CAUTION.TIF",(214,50)
  376. 31230  FOR II=1 TO 4
  377. 31232    LOCATE 40,3:COLOR 6:PRINT CMES$;:'28chr
  378. 31234    WAIT SWAIT/10
  379. 31236    LOCATE 40,3:PRINT SPACE$(28)
  380. 31237    WAIT SWAIT/10
  381. 31238  NEXT II
  382. 31239  LOCATE 40,3:COLOR 7:PRINT CMES$;:MESN=19:GOSUB *SNDMSG
  383. 31240  G=2:GOSUB *マウスボタン選択
  384. 31245  G=2:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  385. 31250  LOCATE 40,3:PRINT SPACE$(28)
  386. 31260  FOR II=1 TO 1000:NEXT II
  387. 31270  PUT@A(214,50)-(630,79),CUTN#
  388. 31272  'GOSUB *日付表示
  389. 31275  RETURN
  390. 31280 '
  391. 35000 *HKIOPN:'---------- インデックスファイルオープン
  392. 35005  DRV$=LEFT$(DATDRV$,2)
  393. 35010  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35020
  394. 35015  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  395. 35020  FLN$=DRV$+"(38)"+PATH$+"\HLIDX.DAT"
  396. 35030  OPEN "R",#2,FLN$
  397. 35040  FIELD #2,6 AS I$(1),32 AS I$(2)
  398. 35050  IR=LOF(2)
  399. 35060  RETURN
  400. 35070 '
  401. 35100 *HKDOPN:'---------- 家計簿データファイルオープン
  402. 35105  DRV$=LEFT$(DATDRV$,2)
  403. 35110  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35120
  404. 35115  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  405. 35120  FLN$=DRV$+"(768)"+PATH$+"\HL"+IYM$+".DAT"
  406. 35130  OPEN "R",#1,FLN$
  407. 35140  FIELD #1,64 AS D$(1),10*16 AS D$(2),32*4 AS D$(3),32*4 AS D$(4),32*4 AS D$(5),32*4 AS D$(6),32 AS D$(7)
  408. 35150  AR=LOF(1)
  409. 35160  RETURN
  410. 35170 '
  411. 36100 *HKIPUT:'---------- インデックスファイル作成
  412. 36110  GOSUB *HKIOPN
  413. 36120  LSET I$(1)=IYM$
  414. 36130  LSET I$(2)=IMK$
  415. 36140  PUT #2,RI
  416. 36150  CLOSE #2
  417. 36160  RETURN
  418. 36170 '
  419. 36300 *HKDPUT:'---------- 家計簿データ書き込み
  420. 36310  GOSUB *HKDOPN
  421. 36320  R=RDY
  422. 36330  LSET D$(1)=DEV$
  423. 36340  DX$="":FOR II=1 TO 16:DX$=DX$+DYN$(II   ):NEXT II:LSET D$(2)=DX$
  424. 36342  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 0):NEXT II:LSET D$(3)=DX$
  425. 36343  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 4):NEXT II:LSET D$(4)=DX$
  426. 36344  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 8):NEXT II:LSET D$(5)=DX$
  427. 36345  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+12):NEXT II:LSET D$(6)=DX$
  428. 36346  LSET D$(7)=DDM$
  429. 36350  PUT #1,R
  430. 36360  CLOSE #1
  431. 36370  RETURN
  432. 36380 '
  433. 37190 '
  434. 37290 '
  435. 39000 *CONFIGファイルチェック'  V10 1993.02.07
  436. 39010  OPEN "R",#1,"(1)HK.CFG"
  437. 39020  FIELD #1,1 AS D$
  438. 39030  IF LOF(1)=0 THEN *CFGFE1
  439. 39035  CLOSE
  440. 39040  OPEN "I",#1,"HK.CFG"
  441. 39050  GOSUB *CFGREAD:PRGDRV$=CFG$:'-- PRGDRV$
  442. 39052  GOSUB *CFGREAD:DATDRV$=CFG$:'-- DATDRV$
  443. 39054  GOSUB *CFGREAD:RAMDRV$=CFG$:'-- RAMDRV$
  444. 39056  TIFDRV$=PRGDRV$+"\TIFF"    :'-- TIFDRV$
  445. 39058  GOSUB *CFGREAD:FMBDRV$=CFG$:'-- FMBDRV$
  446. 39060  GOSUB *CFGREAD             :'-- SNDMF
  447. 39062    IF LEFT$(CFG$,5)<>"SNDMF" THEN *CFGFE2
  448. 39064    SNDMF=VAL(RIGHT$(CFG$,1))
  449. 39066  GOSUB *CFGREAD:SNDDRV$=CFG$:'-- SNDDRV$
  450. 39068  GOSUB *CFGREAD             :'-- SWAIT
  451. 39070    IF LEFT$(CFG$,4)<>"WAIT" THEN *CFGFE2
  452. 39072    SWAIT=VAL(RIGHT$(CFG$,LEN(CFG$)-5))
  453. 39080  FOR II=1 TO 15
  454. 39082    GOSUB *CFGREAD:CFI$(II)=CFG$
  455. 39084  NEXT II
  456. 39140  CLOSE
  457. 39150  RETURN
  458. 39200 *CFGFE1
  459. 39220  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルが見当たりません｡ 家計簿を終了します｡"
  460. 39230  CLOSE:WAIT 100:GOTO *S04
  461. 39300 *CFGFE2
  462. 39320  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの内容に誤りがあります｡ 家計簿を終了します｡"
  463. 39330  CLOSE:WAIT 100:GOTO *S04
  464. 39400 *CFGFE3
  465. 39420  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの項目に不足があります｡ 家計簿を終了します｡"
  466. 39430  CLOSE:WAIT 100:GOTO *S04
  467. 39500 *CFGREAD
  468. 39510  IF EOF(1)<>0 THEN *CFGFE3
  469. 39520  LINE INPUT #1,CFG$
  470. 39530  IF LEFT$(CFG$,1)="/" THEN 39510
  471. 39540  RETURN
  472. 39990 '
  473. 40000 *ボタン座標:'-------------------------------------------------------
  474. 40010 DATA 2   'SWGN        スイッチグループ数 
  475. 40090 '/////////////////////////////
  476. 40100 '-------------------- メインメニュースイッチグループ
  477. 40110 '    SWN(G),SMX,SMY,SMW
  478. 40120 DATA     4 ,0.8,0.8,  0
  479. 40130 '    XB1 XB2 YB1 YB2 SWM$         SMC
  480. 40140 DATA 220,293, 89,115',"記入･編集",0
  481. 40150 DATA 294,363, 89,115'," 検   索 ",0
  482. 40160 DATA 364,433, 89,115'," 分   析 ",0
  483. 40170 DATA 434,483, 89,115',"終わり",2
  484. 40500 '-------------------- スイッチグループ[2]
  485. 40510 '    SWN(G),SMX,SMY,SMW
  486. 40520 DATA     2 ,0.8,0.8,  0
  487. 40530 '    XB1 XB2 YB1 YB2 SWM$         SMC
  488. 40540 DATA 552,583, 56, 73',"  OK  ",1   01
  489. 40550 DATA 584,615, 56, 73',"  NG  ",1   02
  490. 60000 '
  491. 60010 ' 座標確認 DEBUG ROUTINE
  492. 60020 '
  493. 60030 MOUSE 0:MOUSE 1,0,0,1
  494. 60040  IF MOUSE(2,1)<>0 THEN STOP
  495. 60050  IF MOUSE(2,0)=0 THEN 60050
  496. 60060  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):LX=INT(X_M/8):LY=INT(Y_M/19)
  497. 60070  LOCATE 2,24:COLOR 7:PRINT "X=";X_M,"Y=";Y_M,"LX=";LX,"LY=";LY;
  498. 60080  GOTO 60040
  499. 61000 ' 
  500.